home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Libraries / SAT 2.1.2 / HeartQuest sample ƒ / Preferences.p < prev    next >
Encoding:
Text File  |  1994-06-09  |  7.5 KB  |  255 lines  |  [TEXT/PJMM]
  1. ätta alwaysExternal efter den? (Bra idé!) Kan man kolla om}
  2. {file sharing är på?}
  3.  
  4. unit Preferences;
  5.  
  6. {Made with help from the sources of}
  7. {DeHQX v2.0.0 © Peter Lewis, Aug 1991 }
  8. {Many thanks to Peter for sharing his sources with us!}
  9.  
  10. interface
  11.  
  12.     var
  13.         gAppFile, gPrefFile: integer; {refnumbers to pass to UseResFile.}
  14.         sysenv: SysEnvRec;
  15.  
  16.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  17. {Open the pref file if needed. Set the global variables gAppFile and gPrefFile.}
  18. {If alwaysExternal is true, we always want a pref file in the system folder even if we can save in the application.}
  19. {Returns true if a new gPrefFile was created.}
  20.  
  21. {Copy a resource from one file to another. Useful when SetPrefFile returns true!}
  22.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  23.  
  24. implementation
  25.  
  26. { 1) hitta Preferencefolder}
  27. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  28. { 3) Hämta resurs och ändra den med ChangeResource. Om det gick, gå till 6.}
  29. { 4) Skapa prefsfil och öppna den.}
  30. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  31. { 6) Hämta resurser och skapa om de inte finns.}
  32.  
  33.     const
  34. {Följande inte längre hårdkodat!!!}
  35. {PrefsFileName = 'Hexmap Prefs';}
  36. {PrefCreator = '»Hex';}
  37. {PrefType = 'Pref';}
  38.  
  39. { From Folders:}
  40.         kPreferencesFolderType = 'pref';        {preferences for applications go here}
  41.  
  42. { From Folders:}
  43.     function FindFolder (vRefNum: INTEGER; folderType: OSType; createFolder: BOOLEAN; var foundVRefNum: INTEGER; var foundDirID: LONGINT): OSErr;
  44.     inline
  45.         $7000, $A823;
  46.  
  47.     function GetBlessed (vRefNum: INTEGER; var blessed: longint; var volID: integer): OSErr;
  48.         var
  49.             myHPB: HParamBlockRec;
  50.             error: OSErr;
  51.     begin
  52.         blessed := 0;
  53.         with myHPB do
  54.             begin
  55.                 ioNamePtr := nil;
  56.                 ioVRefNum := vRefNum;    {get for default volume}
  57.                 ioVolIndex := 0;        {we’re not making indexed calls}
  58.                 error := PBHGetVInfo(@myHPB, FALSE);
  59.                 if error = noErr then
  60.                     begin
  61.                         blessed := ioVFndrInfo[1];
  62.                         volID := ioVRefNum;
  63.                     end;
  64.             end; {WITH}
  65.         GetBlessed := error;
  66.     end;
  67.  
  68.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  69.         var
  70.             procID: longInt;
  71.             oe: OSErr;
  72.     begin
  73.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  74.         if oe <> noErr then
  75.             begin
  76.                 vrn := wdrn;
  77.                 dirID := 0;
  78.             end;
  79.         GetDirID := oe;
  80.     end;
  81.  
  82.     function GetPrefsFolder (var ovrn: integer): OSErr;
  83.         var
  84.             vrn: integer;
  85.             sDirID: longint;
  86.             oe: OSErr;
  87.             pb: WDPBRec;
  88.             oDirID: longint; {förr var-deklarerad utvariabel}
  89.             oVolID: integer;{förr var-deklarerad utvariabel}
  90.     begin
  91.         vrn := sysenv.sysVRefNum;
  92. {ReportStr(stringof('SysEnv: ', sysenv.sysVRefNum));}
  93.         if sysenv.systemVersion >= $0700 then {System7}
  94.             begin
  95. {oe := GetBlessed(ovrn, oDirID, oVolID);}
  96.                 sDirID := 0;
  97.                 oe := GetDirID(vrn, vrn, sDirID);
  98. {ReportStr(stringof('kjsajkd: ', vrn, ' ', sDirID));}
  99.                 oe := FindFolder(vrn, kPreferencesFolderType, true, oVolID, oDirID);
  100. {ReportStr(stringof('FindFolder: ', oVolID, ' ', oDirID));}
  101. {ovrn := sysenv.sysVRefNum;}
  102.  
  103. {Konvertera FindFolders volref+dirid till WDref}
  104.                 pb.ioVRefNum := oVolID;
  105.                 pb.ioWDProcID := longint('ERIK');
  106.                 pb.ioWDDirID := oDirID;
  107.                 pb.ioWDIndex := 0;
  108. {pb.ioWDVRefNum := -1; {???}
  109.                 pb.ioNamePtr := nil;
  110.                 pb.ioCompletion := nil;
  111.                 oe := PBOpenWD(@pb, false);
  112.                 ovrn := pb.ioVRefNum; {WDRefNum}
  113.             end
  114.         else
  115.             begin
  116.                 ovrn := vrn;
  117. {oe := GetBlessed(ovrn, oDirID, oVolID);}
  118.                 oe := NoErr;
  119.             end;
  120.         GetPrefsFolder := oe;
  121.     end;
  122.  
  123. {function SetPrefFile: boolean;}
  124.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  125.         var
  126.             err: OSErr;
  127.             PrefsFolder{, PrefsVolId}
  128.             : integer;
  129. {PrefsFolderId: longint;}
  130.             h: handle;
  131.             s: str255;
  132.     begin
  133.         gAppFile := CurResFile; {spara programmerts resursfilreferens}
  134.         gPrefFile := 0;
  135.         SetPrefFile := false;
  136. { 1) hitta Preferencefolder}
  137.         err := GetPrefsFolder(PrefsFolder);{, PrefsFolderId, PrefsVolId}
  138.         if err <> NoErr then
  139.             ;
  140. {ReportStr('Error finding system folder.')}
  141.  
  142. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  143.         gPrefFile := OpenRFPerm(PrefsFileName, PrefsFolder, FSRdWrPerm);
  144.         if ResError = noErr then
  145.             begin
  146. {Vi borde kolla pref-fil-versionsnummer!}
  147.             end
  148.         else
  149.             begin
  150.                 gPrefFile := 0;
  151.  
  152. { 3) Hämta resurs och ändra den med ChangeResource. Om det gick, gå till 6.}
  153. {Om alwaysExternal är true behöver vi inte kolla - då vill vi ha en }
  154.                 if alwaysExternal then
  155.                     begin
  156.                         h := Get1Resource(prefCreator, 0); {Programmets signatur finns alltid om den har en BNDL.}
  157.                         if h = nil then
  158.                             begin
  159. {Error! Resursen saknas!}
  160. {ReportStr('Resource missing!');}
  161.                             end;
  162.                         ChangedResource(h);
  163.                         alwaysExternal := ResError <> noErr; {Lite fult att ändra "always", men nu vill vi ju ha extern!}
  164.                         ReleaseResource(h); {OK, vi är klara med resursen}
  165.                     end;
  166.  
  167.                 if alwaysExternal then
  168.                     begin
  169. { 4) Skapa prefsfil och öppna den.}
  170.                         err := Create(PrefsFileName, PrefsFolder, PrefCreator, PrefType);
  171.                         if err = noErr then
  172.                             begin
  173.                                 ;
  174. {ReportStr('Application locked. Creating prefs file instead.')}
  175.  
  176.                                 HCreateResFile(PrefsFolder, 0, PrefsFileName);{???}
  177.                                 if ResError <> noErr then
  178.                                     begin
  179. {ReportStr('Couldn''t create resource fork!');}
  180.                                     end
  181.                                 else
  182.                                     gPrefFile := OpenRFPerm(PrefsFileName, PrefsFolder, FSRdWrPerm);
  183.  
  184.                                 if ResError = noErr then
  185.                                     SetPrefFile := true; {new pref file!}
  186. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  187.                             end{Create lyckades}
  188.                         else
  189. {ReportStr('Failed to create prefsfile!')}
  190.                             ;
  191.                     end; {Programmet skrivskyddat.}
  192.             end; {prefsfil existerade inte}
  193. { 6) Hämta resurser och skapa om de inte finns.}
  194.     end;
  195.  
  196.  
  197. {Kopiera resurs:}
  198.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  199.         var
  200.             oldResFile: integer;
  201.             res, rescopy: Handle;
  202.             wasLoaded: Boolean;
  203.             theID: integer;
  204.             theType: ResType;
  205.             theName: Str255;
  206.         procedure Barf;
  207.         begin
  208.             CopyResource := ResError;
  209.             UseResFile(oldResFile); {återställ}
  210.             exit(CopyResource);
  211.         end;
  212.         procedure CheckError;
  213.         begin
  214.             if ResError <> noErr then
  215.                 Barf;
  216.         end; {CheckError}
  217.     begin
  218.         oldResFile := CurResFile;
  219.         UseResFile(fromFile);
  220.         CheckError;
  221.  
  222.         SetResLoad(false);
  223.         res := Get1Resource(theResType, id);
  224. {Don't CheckError before doing SetResLoad(true)!!!}
  225.         SetResLoad(true);
  226.         CheckError;
  227.         if res <> nil then
  228.             begin
  229.                 wasLoaded := res^ = nil;
  230.                 LoadResource(res);
  231.                 CheckError;
  232.                 UseResFile(toFile);
  233.                 CheckError;
  234.                 GetResInfo(res, theID, theType, theName);
  235.                 CheckError;
  236.                 rescopy := res;
  237.                 if HandToHand(rescopy) <> noErr then
  238.                     Barf; {i stället för DetachResource(res);}
  239.                 CheckError;
  240.                 AddResource(rescopy, theResType, id, theName);
  241.                 CheckError;
  242.                 ReleaseResource(rescopy);
  243.                 if not wasLoaded then
  244.                     ReleaseResource(res); {If it wasn't loaded before, it shouldn't be afterwards.}
  245.                 CheckError;
  246.                 CopyResource := noErr;
  247.             end
  248.         else
  249.             begin
  250.                 CopyResource := resNotFound;
  251.             end;
  252.         UseResFile(oldResFile);
  253.     end;
  254.  
  255. end.